In VISUALIZATION VIBES project Study 2, participants completed an attitutde eliciation survey, asking questions about their attitude toward (5) stimulus images (data visualizations). Each participant was randomly assigned to one of 6 stimulus blocks, each containing 1 image from each of (4) pseudo-categories (ranging from most abstract to most figural). Each participant started by responding to questions for a single ‘common’ stimulus (that is thus super-powered as it was seen by all participants). Two participant recruitment pools were used: Prolific, with a smaller set of participants recruited from Tumblr (to replicate and compare survey results to Study 1 interviews with participants sourced from Tumblr).
This notebook contains code to replicate quantitative analysis of data from Study 2 reported in the CHI submission. Note that due to limited space, we were unable to report results for all stimulus blocks, and all possible analyses. A separate set of R notebooks are included in the supplementary materials that document analysis of the other blocks not reported here.
This notebook includes analysis and exploration of the data set at the stimulus category level
We start by importing data files previously wrangled in
0_VIBES_S2_wrangling.Rmd.
############## IMPORT REFERENCE FILES
ref_stimuli <- readRDS("data/input/REFERENCE/ref_stimuli.rds")
ref_surveys <- readRDS("data/input/REFERENCE/ref_surveys.rds")
ref_labels <- readRDS("data/input/REFERENCE/ref_labels.rds")
ref_labels_abs <- readRDS("data/input/REFERENCE/ref_labels_abs.rds")
############## SETUP Graph Labels
ref_stim_id <- levels(ref_stimuli$ID)
ref_cat_questions <- c("MAKER_ID","MAKER_AGE","MAKER_GENDER")
ref_free_response <- c("MAKER_DETAIL", "MAKER_EXPLAIN", "TOOL_DETAIL", "CHART_EXPLAIN")
ref_conf_questions <- c("MAKER_CONF", "AGE_CONF", "GENDER_CONF", "TOOL_CONF")
ref_sd_questions <- rownames(ref_labels)
ref_sd_questions_abs <- rownames(ref_labels_abs)
# ref_blocks <- c("block1", "block2", "block3", "block4", "block5", "block6")
ref_blocks <- c(1,2,3,4,5,6)
############## IMPORT DATA FILES
# df_data <- readRDS("data/output/df_data.rds") #1 row per participant — WIDE
df_participants <- readRDS("data/output/df_participants.rds") #1 row per participant — demographic
df_questions <- readRDS("data/output/df_questions.rds") #1 row per question — LONG
df_sd_questions_wide <- readRDS("data/output/df_sd_questions_wide.rds") # only sd questions WIDE
df_tools <- readRDS("data/output/df_tools.rds") #multiselect format for tools Question
df_actions <- readRDS("data/output/df_actions.rds") # multiselect format for action Question
# # df_graphs_full <- readRDS("data/output/df_graphs_full.rds") #includes free response data
df_graphs <- readRDS("data/output/df_graphs.rds") #only categorical and numeric questions
df_sd_questions_long <- readRDS("data/output/df_sd_questions_long.rds") # only sd questions LONG
### DATA FILES WITH (VARIABLE-WISE) Z-SCORED SEMANTIC DIFFERENTIAL QS
df_graphs_z <- readRDS("data/output/df_graphs_z.rds") #only categorical and numeric questions
df_sd_questions_long_z <- readRDS("data/output/df_sd_questions_long_z.rds") # only sd questions LONG
### DATA FILES WITH ABSOLUTE VALUE SEMANTIC DIFFERENTIAL QS
df_graphs_abs <- readRDS("data/output/df_graphs_abs.rds") #only categorical and numeric questions
df_sd_questions_long_abs <- readRDS("data/output/df_sd_questions_long_abs.rds") # only sd questions LONG
############## SETUP Colour Palettes
#https://www.r-bloggers.com/2022/06/custom-colour-palettes-for-ggplot2/
## list of color pallettes
my_colors = list(
politics = c("#184aff","#5238bf", "#4f4a52" ,"#84649c", "#ff0000"),
blackred = c("black","red"),
greys = c("#707070","#999999","#C2C2C2"),
greens = c("#ADC69D","#81A06D","#567E39","#2D5D16","#193E0A"),
smallgreens = c("#ADC69D","#567E39","#193E0A"),
olives = c("#CDCEA1","#B8B979","#A0A054","#78783F","#50502A","#35351C"),
lightblues = c("#96C5D2","#61A2B2","#3C8093","#2C6378","#1F4A64"),
darkblues = c("#7AAFE1","#3787D2","#2A73B7","#225E96","#1A4974","#133453"),
reds = c("#D9B8BD","#CE98A2","#B17380","#954E5F","#78263E","#62151F"),
traffic = c("#CE98A2","#81A06D","yellow"),
questions = c("#B17380","#3787D2", "#567E39", "#EE897F"),
tools= c("#D55662","#EE897F","#F5D0AD","#A0B79B","#499678","#2D363A"),
encounter = c("#729B7D","#8E8E8E"),
actions = c("#2A363B","#039876ff","#99b898ff","#fdcea8ff","#ff837bff","#e84a60ff"),
platforms = c("#5D93EA","#FF70CD", "#3BD3F5", "#8B69B5","black"),
amy_gradient = c("#ac57aa", "#9e5fa4", "#90689f", "#827099", "#747894", "#66818e", "#578988", "#499183", "#3b997d", "#2da278", "#1faa72"),
my_favourite_colours = c("#702963", "#637029", "#296370")
)
## function for using palettes
my_palettes = function(name, n, all_palettes = my_colors, type = c("discrete","continuous"), direction = c("1","-1")) {
palette = all_palettes[[name]]
if (missing(n)) {
n = length(palette)
}
type = match.arg(type)
out = switch(type,
continuous = grDevices::colorRampPalette(palette)(n),
discrete = palette[1:n]
)
out = switch(direction,
"1" = out,
"-1" = palette[n:1])
structure(out, name = name, class = "palette")
}
############## RETURNS SD STACKED AND COLORED BY BY X
## LOOP STYLE
multi_sd <- function (data, left, right, x, y, color) {
# g <- ggplot(df, aes(y = .data[[x]], x = {{y}}, color = {{color}}))+
g <- ggplot(data, aes(y = .data[[x]], x = .data[[y]], color = .data[[color]]))+
geom_boxplot(width = 0.5) +
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
guides(
y = guide_axis_manual(labels = left),
y.sec = guide_axis_manual(labels = right)
) + theme_minimal()
return(g)
}
############## RETURNS SINGLE SD
## LOOP STYLE
single_sd <- function (data, left, right, x) {
g <- ggplot(data, aes(y = {{x}}, x = ""))+
geom_boxplot(width = 0.5) +
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
guides(
y = guide_axis_manual(labels = left),
y.sec = guide_axis_manual(labels = right)
) + theme_minimal()
return(g)
}
######## RETURNS SINGLE SD
## APPLY STYLE
plot_sd = function (data, column, type, mean, facet, facet_by, boxplot) {
ggplot(data, aes(y = .data[[column]], x="")) +
{if(boxplot) geom_boxplot(width = 0.5) } +
geom_jitter(width = 0.1, alpha=0.2, {if(facet) aes(color=.data[[facet_by]])}) +
{if(mean)
stat_summary(fun="mean", geom="point", shape=20, size=5, color="blue", fill="blue")
} +
{if(mean)
## assumes data has been passed in with mean column at m
# stat_summary(fun="mean", geom="text", colour="blue", fontface = "bold",
# vjust=-1.25, hjust = 0.50, aes( label=round(..y.., digits=0)))
stat_summary(fun="mean", geom="text", colour="blue", fontface = "bold",
vjust=-1.25, hjust = 0.50, aes( label=round(..y.., digits=0)))
} +
{if(facet) facet_grid(.data[[facet_by]] ~ .)} +
# scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
{if(type == "S")
guides(
y = guide_axis_manual(labels = ref_labels[column,"left"]),
y.sec = guide_axis_manual(labels = ref_labels[column,"right"])
)} +
{if(type == "Q")
guides(
y = guide_axis_manual(labels = ref_labels[q,"left"]),
y.sec = guide_axis_manual(labels = ref_labels[q,"right"])
)} +
theme_minimal() +
labs (
caption = column
) + easy_remove_legend()
}
For the purpose of optimizing aesthetic diversity of stimuli seen by each participant, we organized the stimuli into 4 approximate ‘categories’ of abstraction, where A = the most abstract, and D the most figural. Each participant first saw the common stimulus (B0-0) followed by one stimulus from each category (order randomized) in a block structure.
df <- df_participants
## FOR DESCRIPTIVES PARAGRAPH
# #PROLIFIC
df.p <- df %>% filter(Distribution == "PROLIFIC")
desc.gender.p <- table(df.p$D_gender) %>% prop.table()
names(desc.gender.p) <- levels(df.p$D_gender)
p_participants <- nrow(df.p)
# #TUMBLR
df.t <- df %>% filter(Distribution == "TUMBLR")
desc.gender.t <- table(df.t$D_gender) %>% prop.table()
names(desc.gender.t) <- levels(df.t$D_gender)
t_participants <- nrow(df.t)
For study 2, a total of 318 participants were recruited from US-located English speaking users of TUMBLR (n = 78) and PROLIFIC (n = 240).
240 individuals from PROLIFIC participated in Study 2, ( 54% Female, 42% Male, 3% Non-binary, 1% Other).
78 individuals from Tumblr participated in Study 2, ( 36% Female, 5% Male, 40% Non-binary, 19% Other). Note that a higher proportion of participants recruited from TUMBLR report identities other than cis-gender Female and cis-gender Male.
df <- df_participants
## for descriptives paragraph
p.desc.duration <- psych::describe(df %>% filter(Distribution=="PROLIFIC") %>% pull(duration.min))
t.desc.duration <- psych::describe(df %>% filter(Distribution=="TUMBLR") %>% pull(duration.min))
PROLIFIC SAMPLE (n = 240 ) participant response times ranged from 13.97 to 216.18 minutes, with a mean response time of 42.49 minutes, SD = 21.15.
TUMBLR SAMPLE (n = 78 ) participant response times ranged from 10.88 to 227.57 minutes, with a mean response time of 51.93 minutes, SD = 35.47.
rm(df, df.p, df.t, p.desc.duration, t.desc.duration, desc.gender.p, desc.gender.t, p_participants, t_participants)
#full data except for common stimulus B0-0
df_cat <- df_graphs %>%
filter(STIMULUS != "B0-0") %>%
mutate(
STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY),
STUDY = "" #dummy variable for univariate visualizations
)
# %>%
# mutate(MAKER_ID = fct_rev(MAKER_ID))
When asking participants to identify the type, age and gender of the maker of a visualization, we also asked participants to indicate their confidence in these choices.
Across all participants and all stimuli, are these (categorical) questions answered with the same degree of confidence?
Here we examine both the central tendency (mean) and shape of the distribution for each confidence variable.
df <- df_cat %>% select(PID, Distribution, STIMULUS_CATEGORY, STIMULUS,MAKER_CONF, AGE_CONF, GENDER_CONF, TOOL_CONF) %>%
pivot_longer(
cols = c(MAKER_CONF, AGE_CONF, GENDER_CONF, TOOL_CONF),
names_to = "QUESTION",
values_to = "CONFIDENCE"
) %>%
mutate(
QUESTION = factor(QUESTION, levels=c("MAKER_CONF","AGE_CONF","GENDER_CONF","TOOL_CONF" ) )
) %>%
group_by(QUESTION, STIMULUS_CATEGORY) %>%
mutate(
m=round(mean(CONFIDENCE),0) #calc mean for showing in plots
)
## B
## CONFIDENCE ACROSS QUESTIONS (all stimuli, all Pps)
## BOXPLOT W/ JITTER
B <-
df %>%
ggplot(aes(x=STIMULUS_CATEGORY, y= CONFIDENCE, fill = STIMULUS_CATEGORY)) +
geom_jitter(aes(color = STIMULUS_CATEGORY), alpha = 0.25, position=position_dodge2(width = 0.25)) +
geom_boxplot(width = 0.5) +
facet_wrap(~QUESTION)+
## MEAN
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold", size=3,
vjust=+0.5, hjust = -1.5, aes( label=round(m, digits=0)))+
stat_summary(fun=mean, geom="point", size=2, color="blue", fill="blue") +
theme_minimal() + easy_remove_legend()
labs(title = "Confidence by Question and Stimulus Category", caption = "(mean in blue)")
## $title
## [1] "Confidence by Question and Stimulus Category"
##
## $caption
## [1] "(mean in blue)"
##
## attr(,"class")
## [1] "labels"
## R
## CONFIDENCE ACROSS QUESTIONS (all stimuli, all Pps)
## RIDGEPLOT W/ INTERVAL MEAN
R <-
df %>%
ggplot(aes(x=CONFIDENCE, y=STIMULUS_CATEGORY, fill=STIMULUS_CATEGORY)) +
geom_density_ridges(scale = 0.65, alpha = 0.75, quantile_lines = TRUE) +
scale_x_continuous(limits = c(0,100))+
# scale_fill_manual(values = my_palettes(name="questions", direction = "-1"), name = "", guide = guide_legend(reverse = TRUE)) +
stat_pointinterval(side = "bottom", scale = 0.7, slab_linewidth = NA, point_interval = "mean_qi") +
facet_wrap(~QUESTION)+
## MEAN
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold", size=3,
vjust=+2.5, hjust = 0.50, aes( label=round(m, digits=0)))+
stat_summary(fun=mean, geom="point", size=2, color="blue", fill="blue") +
theme_minimal() +
labs(title = "Confidence by Question and Stimulus Category", y = "QUESTION", caption =" (mean in blue)") +
easy_remove_legend()
B
R
## Picking joint bandwidth of 6.35
## Picking joint bandwidth of 5.91
## Picking joint bandwidth of 7.16
## Picking joint bandwidth of 6.14
Participants were asked:
Who do you think is most likely responsible for having this
image created?
options: (select one). The response is stored as
MAKER_ID
business or corporation
journalist or news outlet
educational or academic institution
government or political organization
other organization
an individual]
Participants were also asked: Please rate your confidence in
this choice. The response is stored as MAKER_CONF
.
#FILTER DATASET
df <- df_cat
## D
## MAKER IDENTIFICATION AGGREGATED (all)
## GGSTATSPLOT
##############################
#hack for consistent ordering of ggstats bar plot
dx <- df %>% mutate( MAKER_ID = fct_rev(MAKER_ID) )
S <- ggbarstats( data = dx, x = MAKER_ID, y = STIMULUS_CATEGORY,
results.subtitle = FALSE,
legend.title = "MAKER ID") +
scale_fill_manual(values = my_palettes(name="reds", direction = "1")) +
theme_minimal() +
labs( title = "", x = "", y="") +
theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
##############################
## H
## HALF EYE SLAB GGDIST
##############################
H <-
df %>%
group_by(MAKER_ID, STIMULUS_CATEGORY) %>%
mutate(count = n(), m = mean(MAKER_CONF)) %>%
ggplot(aes(y = MAKER_CONF, x = fct_rev(MAKER_ID), fill = fct_rev(MAKER_ID))) +
stat_halfeye(scale=0.55, density="bounded", point_interval = "mean_qi", normalize= "all") +
facet_wrap(~STIMULUS_CATEGORY)+
## MEAN
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold", size = 2,
vjust=2.5, hjust = .5, aes( label=round(m, digits=0)))+
stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
scale_fill_manual(values = my_palettes(name="reds", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
geom_text(aes(label= paste0("n=",count) , y = 5), color = "black",
size = 3, nudge_x=0.35) +
labs(y="Maker ID Confidence", x="") +
theme_minimal() +
easy_remove_legend()+
coord_flip()
##############################
S + plot_annotation(
title = "Maker ID by STIMULUS CATEGORY",
# subtitle = "the categories of MAKER ID were chosen in similar proportion,
# and both the mean (in blue) and shape of distribution of confidence scores is similar across values of Maker ID",
caption = "(blue indicates mean)"
)
H + plot_annotation(
title = "Maker ID Confidence by STIMULUS CATEGORY",
# subtitle = "the categories of MAKER ID were chosen in similar proportion,
# and both the mean (in blue) and shape of distribution of confidence scores is similar across values of Maker ID",
caption = "(blue indicates mean)"
)
Participants were asked: Take a moment to imagine the
person(s) responsible for creating the image. What generation are they
most likely from?
options: (select one) The response was saved as
MAKER_AGE
boomers (60+ years old)
Generation X (44-59 years old)
Millennials (28-43 years old)
Generation Z (12 - 27 years old]
Participants were asked: Please rate your confidence in this
choice. The response is stored as AGE_CONF .
#FILTER DATASET
df <- df_cat
## D
## MAKER IDENTIFICATION AGGREGATED (all)
## GGSTATSPLOT
##############################
#hack for consistent ordering of ggstats bar plot
dx <- df %>% mutate( MAKER_AGE = fct_rev(MAKER_AGE) )
S <- ggbarstats( data = dx, x = MAKER_AGE, y = STIMULUS_CATEGORY,
legend.title = "MAKER AGE",
results.subtitle = FALSE) +
scale_fill_manual(values = my_palettes(name="lightblues", direction = "1")) +
theme_minimal() +
labs( title = "", x = "", y="") +
theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
##############################
## H
## HALF EYE SLAB GGDIST
##############################
H <- df %>%
group_by(MAKER_AGE, STIMULUS_CATEGORY) %>%
mutate(count = n(), m = mean(AGE_CONF)) %>%
ggplot(aes(y = AGE_CONF, x = fct_rev(MAKER_AGE), fill = fct_rev(MAKER_AGE))) +
stat_halfeye(scale=0.55, density="bounded", point_interval = "mean_qi", normalize= "all") +
facet_wrap(~STIMULUS_CATEGORY)+
## MEAN
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold", size = 2,
vjust=2.5, hjust = .5, aes( label=round(..y.., digits=0)))+
stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
scale_fill_manual(values = my_palettes(name="lightblues", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
geom_text(aes(label= paste0("n=",count) , y = 5), color = "black",
size = 3, nudge_x=0.35) +
labs(y="Maker AGE Confidence", x="") +
theme_minimal() +
easy_remove_legend()+
coord_flip()
##############################
S + plot_annotation(
title = "Maker AGE by STIMULUS CATEGORY",
# subtitle = "The value
# distribution of confidence scores is similar across values of Maker AGE",
caption = "(blue indicates mean)"
)
H + plot_annotation(
title = "Maker AGE Confidence by STIMULUS CATEGORY",
# subtitle = "The value
# distribution of confidence scores is similar across values of Maker AGE",
caption = "(blue indicates mean)"
)
Participants were asked: Take a moment to imagine the
person(s) responsible for creating the image. What gender do they most
likely identify with?
options: [female / male / other ] (select one).
Responses were stored as MAKER_GENDER.
Participants were asked: Please rate your confidence in this
choice. The response is stored as GENDER_CONF
.
#FILTER DATASET
df <- df_cat
## D
## MAKER IDENTIFICATION AGGREGATED (all)
## GGSTATSPLOT
##############################
#hack for consistent ordering of ggstats bar plot
dx <- df %>% mutate( MAKER_AGE = fct_rev(MAKER_AGE) )
S <- ggbarstats( data = dx, x = MAKER_GENDER, y = STIMULUS_CATEGORY,
legend.title = "MAKER GENDER",
results.subtitle = FALSE) +
scale_fill_manual(values = my_palettes(name="smallgreens", direction = "1")) +
theme_minimal() +
labs( title = "", x = "", y="") +
theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
##############################
## H
## HALF EYE SLAB GGDIST
##############################
H <- df %>%
group_by(MAKER_GENDER, STIMULUS_CATEGORY) %>%
mutate(count = n(), m = mean(GENDER_CONF)) %>%
ggplot(aes(y = GENDER_CONF, x = MAKER_GENDER, fill = MAKER_GENDER)) +
stat_halfeye(scale=0.55, density="bounded", point_interval = "mean_qi", normalize= "all") +
facet_wrap(~STIMULUS_CATEGORY) +
## MEAN
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold", size = 2,
vjust=2.5, hjust = .5, aes( label=round(..y.., digits=0)))+
stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
scale_fill_manual(values = my_palettes(name="greens", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
geom_text(aes(label= paste0("n=",count) , y = 5), color = "black",
size = 3, nudge_x=0.35) +
labs(y="Maker GENDER Confidence", x="") +
theme_minimal() +
easy_remove_legend()+
coord_flip()
##############################
S + plot_annotation(
title = "Maker GENDER by STIMULUS CATEGORY",
# subtitle = "The value
# distribution of confidence scores is similar across values of Maker AGE",
caption = "(blue indicates mean)"
)
H + plot_annotation(
title = "Maker GENDER Confidence by STIMULUS_CATEGORY",
# subtitle = "The value
# distribution of confidence scores is similar across values of Maker AGE",
caption = "(blue indicates mean)"
)
Participants were asked: What tools do you think were most
likely used to create this image?
options: (select all that apply). The response was
saved as variable TOOL_ID (multi-select)
basic graphic design software (e.g. Canva, or similar)
advanced graphic design software (e.g. Adobe Illustrator, Figma, or similar)
data visualization software (e.g. Tableau, PowerBI, or similar)
general purpose software (e.g. MS Word/Excel, Google Sheets, or similar)
programming language (e.g. R, python, javascript, or similar)
Participants were asked: Please rate your confidence in this
choice. The response is stored as TOOL_CONF .
#FILTER DATASET
df <- df_tools %>%
mutate(
STUDY = "",
STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY)
)
## D
## MAKER IDENTIFICATION AGGREGATED (all)
## GGSTATSPLOT
##############################
#hack for consistent ordering of ggstats bar plot
S <- ggbarstats( data = df, x = TOOL_ID, y = STIMULUS_CATEGORY,
legend.title = "TOOL ID", results.subtitle = FALSE) +
scale_fill_paletteer_d("awtools::a_palette", direction = 1)+
theme_minimal() +
labs( title = "", x = "", y="") +
theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
##############################
## H
## HALF EYE SLAB GGDIST
##############################
H <- df %>%
group_by(TOOL_ID, STIMULUS_CATEGORY) %>%
mutate(count = n(), m = mean(TOOL_CONF)) %>%
ggplot(aes(y = TOOL_CONF, x = TOOL_ID, fill = TOOL_ID)) +
stat_halfeye(scale=0.55, density="bounded", point_interval = "mean_qi", normalize= "all") +
facet_wrap(~STIMULUS_CATEGORY) +
## MEAN
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold", size = 2,
vjust=2.5, hjust = .5, aes( label=round(..y.., digits=0)))+
stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
scale_fill_manual(values = my_palettes(name="tools", direction = "1"), guide = guide_legend(reverse = TRUE)) +
geom_text(aes(label= paste0("n=",count) , y = 5), color = "black",
size = 3, nudge_x=0.35) +
labs(y="TOOL ID Confidence", x="", caption="(mean in blue) (median in red)") +
theme_minimal() +
easy_remove_legend()+
coord_flip()
##############################
S + plot_annotation(
title = "TOOL ID by STIMULUS CATEGORY",
# subtitle = "The value
# distribution of confidence scores is similar across values of Maker AGE",
caption = "(blue indicates mean)"
)
H + plot_annotation(
title = "TOOL ID Confidence by STIMULUS CATEGORY",
# subtitle = "The value
# distribution of confidence scores is similar across values of Maker AGE",
caption = "(blue indicates mean)"
)
The first question each participant saw in each stimulus block was: As you’re scrolling through your feed, you see this image. What would you do?
options: keep scrolling, pause and look at the image. (select one)
The response was saved as variable ENCOUNTER
## B
## ENCOUNTER BY STIMULUS
## GGSTATSPLOT
df_cat %>%
ggbarstats(
x = ENCOUNTER, y = STIMULUS_CATEGORY,
legend.title = "ENCOUNTER",
results.subtitle = FALSE) +
scale_fill_manual(values = my_palettes(name="encounter", direction = "-1"))+
theme_minimal() +
labs( title = "ENCOUNTER Choice by STIMULUS_CATEGORY", subtitle = "", x = "")
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
The last question participants were asked in each stimulus block was: Imagine you encounter the following image while scrolling. Which of the following are you most likely to do?
options: (select all that apply). The response was saved as variable
CHART_ACTION
post a comment
share/repost
share/repost WITH comment
look up more information about the topic or source
unfollow/block the source
NOTHING—just keep scrolling
## B
## ACTION BY STIMULUS
## GGSTATSPLOT
df_actions %>% mutate(
CHART_ACTION = fct_rev(CHART_ACTION),
STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY),
STUDY="") %>%
ggbarstats( x = CHART_ACTION, y = STIMULUS_CATEGORY,
legend.title = "CHART ACTION",
results.subtitle = FALSE) +
# scale_fill_paletteer_d("awtools::a_palette", direction = 1)+
scale_fill_manual(values = my_palettes(name="actions", direction = "1"))+
theme_minimal() +
labs( title = "ACTION Choice by CATEGORY ", subtitle = "", x = "")
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## B
## ACTION BY STIMULUS
## GGSTATSPLOT
df_actions %>% mutate(
CHART_ACTION4 = fct_rev(CHART_ACTION4),
STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY),
STUDY="") %>%
ggbarstats( x = CHART_ACTION4, y = STIMULUS_CATEGORY,
legend.title = "collapsed CHART ACTION",
results.subtitle = FALSE) +
# scale_fill_paletteer_d("awtools::a_palette", direction = 1)+
scale_fill_manual(values = my_palettes(name="actions", direction = "1"))+
theme_minimal() +
labs( title = "collapsed ACTION Choice4 by CATEGORY ", subtitle = "", x = "")
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## B
## ACTION BY STIMULUS
## GGSTATSPLOT
df_actions %>% mutate(
CHART_ACTION3 = fct_rev(CHART_ACTION3),
STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY),
STUDY="") %>%
ggbarstats( x = CHART_ACTION3, y = STIMULUS_CATEGORY,
legend.title = "collapsed CHART ACTION",
results.subtitle = FALSE) +
# scale_fill_paletteer_d("awtools::a_palette", direction = 1)+
scale_fill_manual(values = my_palettes(name="actions", direction = "1"))+
theme_minimal() +
labs( title = "collapsed ACTION Choice3 by CATEGORY ", subtitle = "", x = "")
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## B
## ACTION BY STIMULUS
## GGSTATSPLOT
df_actions %>% mutate(
CHART_ACTION2 = fct_rev(CHART_ACTION2),
STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY),
STUDY="") %>%
ggbarstats( x = CHART_ACTION2, y = STIMULUS_CATEGORY,
legend.title = "collapsed CHART ACTION",
results.subtitle = FALSE) +
# scale_fill_paletteer_d("awtools::a_palette", direction = 1)+
scale_fill_manual(values = my_palettes(name="actions", direction = "1"))+
theme_minimal() +
labs( title = "collapsed ACTION Choice2 by CATEGORY ", subtitle = "", x = "")
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
Participants were also asked to rate certain characteristics of the chart, or its maker, along a semantic differential scale, implemented in Qualtrics as a continuous slider ranging from 0 -> 100 with biploar adjectives at the end of each scale. The slider defaulted to the center point (50), and the interface displayed the numeric value of the slider position as a tooltip while the element had focus. Note that on both touch and mouse devices participants could interact with the survey element as a slider (i.e. click and and drag, or touch and drag) or as a visual analogue scale (i.e. click or tap on position along the scale).
The SD scores visualized here are in the same form as the participants’ response scale (slider from 0-100).
#### GROUPED DENSITY RIDGES#############################################################################
# setup dataframe
df <- df_sd_questions_long %>% select(1:8, QUESTION, STIMULUS_CATEGORY, value)
d <- left_join( x = df, y = ref_labels,
by = c("QUESTION" = "ref_sd_questions")) %>%
mutate(
category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
QUESTION = factor(QUESTION, levels=ref_sd_questions),
STIMULUS_CATEGORY = factor(STIMULUS_CATEGORY, levels = c("A","B","C","D","F")))%>%
group_by(QUESTION) %>%
mutate(m=median(value)) ## calc median for printing on graph
( c <-ggplot(d, aes(x = value, y = fct_rev(QUESTION), fill=STIMULUS_CATEGORY))+
geom_density_ridges(scale = 0.75, alpha = 0.5, panel_scaling = TRUE) +
## MEDIAN
stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
vjust=-0.5, hjust = 0.50, aes(label=round(m, digits=0)))+
stat_summary(fun=median, geom="point", size=1) +
facet_grid2(.~STIMULUS_CATEGORY)+
# geom_density_ridges(scale = 1, quantile_lines = TRUE, alpha = 0.25)
guides(
y = guide_axis_manual(labels = rev(ref_labels$left)),
y.sec = guide_axis_manual(labels = rev(ref_labels$right))
) +
labs(title = "by STIMULUS CATEGORY", y = "", caption = "(point is median)") +
cowplot::draw_text(text = ref_sd_questions, x = 40, y= ref_sd_questions, size = 6, vjust=2) + ##raw
# # cowplot::draw_text(text = ref_sd_questions, x = -4, y= ref_sd_questions,size = 10, vjust=-2) + ##z-score
theme_minimal() + easy_remove_legend()
)
## Picking joint bandwidth of 5.16
## Picking joint bandwidth of 5.32
## Picking joint bandwidth of 7.21
## Picking joint bandwidth of 6.27
## Picking joint bandwidth of 6.14
if(graph_save){
ggsave(plot = c, path="figs/level_category/distributions", filename =paste0("combined_by_category","_ridges.png"), units = c("in"), width = 10, height = 14 )
}
## Picking joint bandwidth of 5.16
## Picking joint bandwidth of 5.32
## Picking joint bandwidth of 7.21
## Picking joint bandwidth of 6.27
## Picking joint bandwidth of 6.14
rm(df,d, c)
Here the scale of the semantic differential questions have been collapsed, such that 0 is the midpoint of the scale (indicating uncertainty, or not strongly indicating either of the labelled traits) and both 100 and 0 are 50 (indicating a strong signal toward either of the labelled traits).
#### GROUPED DENSITY RIDGES#############################################################################
# setup dataframe
df <- df_sd_questions_long_abs %>% select(1:8, QUESTION, STIMULUS_CATEGORY, value)
d <- left_join( x = df, y = ref_labels_abs,
by = c("QUESTION" = "ref_sd_questions_abs")) %>%
mutate(
category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
QUESTION = factor(QUESTION, levels=ref_sd_questions),
STIMULUS_CATEGORY = factor(STIMULUS_CATEGORY, levels = c("A","B","C","D","F")))%>%
group_by(QUESTION) %>%
mutate(m=median(value)) ## calc median for printing on graph
( c <-ggplot(d, aes(x = value, y = fct_rev(QUESTION), fill=STIMULUS_CATEGORY))+
geom_density_ridges(scale = 0.75, alpha = 0.5, panel_scaling = TRUE) +
facet_grid2(.~STIMULUS_CATEGORY)+
## MEDIAN
stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
vjust=-0.5, hjust = 0.50, aes(label=round(m, digits=0)))+
stat_summary(fun=median, geom="point", size=1) +
# geom_density_ridges(scale = 1, quantile_lines = TRUE, alpha = 0.25)
guides(
y = guide_axis_manual(labels = rev(ref_labels_abs$left)),
y.sec = guide_axis_manual(labels = rev(ref_labels_abs$right))
) +
labs(title = "by STIMULUS CATEGORY (absolute value)", y = "") +
cowplot::draw_text(text = ref_sd_questions_abs, x = 20, y= ref_sd_questions_abs, size = 6, vjust=2) + ##raw
theme_minimal() + easy_remove_legend()
)
## Picking joint bandwidth of 3.78
## Picking joint bandwidth of 3.72
## Picking joint bandwidth of 4.28
## Picking joint bandwidth of 3.97
## Picking joint bandwidth of 3.84
if(graph_save == TRUE){
ggplot2::ggsave(plot = c, path="figs/level_category/distributions", filename =paste0("ABS_combined_by_category","_ridges.png"), units = c("in"), width = 10, height = 14 )
}
## Picking joint bandwidth of 3.78
## Picking joint bandwidth of 3.72
## Picking joint bandwidth of 4.28
## Picking joint bandwidth of 3.97
## Picking joint bandwidth of 3.84
rm(df, d, c)
df <- df_graphs %>%
filter(STIMULUS != "B0-0") %>%
select(
MAKER_DESIGN, MAKER_DATA,
MAKER_POLITIC, MAKER_ARGUE,
MAKER_SELF, MAKER_ALIGN, MAKER_TRUST,
CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY,
PID)
print("FULL CORRELATION NO RANDOM EFFECT")
## [1] "FULL CORRELATION NO RANDOM EFFECT"
## CALCULATE full correlations with no random effects
c <- df %>% correlation(partial=FALSE, include_factors=FALSE)
(s <- c %>% summary(redundant = FALSE))
## # Correlation Matrix (pearson-method)
##
## Parameter | CHART_BEAUTY | CHART_LIKE | CHART_INTENT | CHART_TRUST | MAKER_TRUST | MAKER_ALIGN | MAKER_SELF | MAKER_ARGUE | MAKER_POLITIC | MAKER_DATA
## ----------------------------------------------------------------------------------------------------------------------------------------------------------
## MAKER_DESIGN | -0.41*** | -0.33*** | -0.03 | -0.17*** | -0.17*** | -0.14*** | 0.16*** | -0.04 | 0.13*** | 0.36***
## MAKER_DATA | -0.19*** | -0.24*** | 0.33*** | -0.39*** | -0.39*** | -0.23*** | 0.18*** | -0.17*** | 0.13*** |
## MAKER_POLITIC | -0.21*** | -0.28*** | 0.21*** | -0.29*** | -0.36*** | -0.44*** | 0.46*** | -0.29*** | |
## MAKER_ARGUE | 0.24*** | 0.30*** | -0.35*** | 0.44*** | 0.51*** | 0.40*** | -0.46*** | | |
## MAKER_SELF | -0.36*** | -0.46*** | 0.34*** | -0.52*** | -0.60*** | -0.65*** | | | |
## MAKER_ALIGN | 0.40*** | 0.51*** | -0.32*** | 0.57*** | 0.64*** | | | | |
## MAKER_TRUST | 0.36*** | 0.49*** | -0.47*** | 0.74*** | | | | | |
## CHART_TRUST | 0.46*** | 0.59*** | -0.50*** | | | | | | |
## CHART_INTENT | -0.12*** | -0.21*** | | | | | | | |
## CHART_LIKE | 0.83*** | | | | | | | | |
##
## p-value adjustment method: Holm (1979)
plot(s, show_data="point") + labs(title = "Correlation Matrix",
subtitle="(full correlation; pearson method; Holm p-value adjustment)") + theme_minimal()
print("PARTIAL CORRELATION WITH PID AS RANDOM EFFECT")
## [1] "PARTIAL CORRELATION WITH PID AS RANDOM EFFECT"
#CALCULATE partial correlations with PID as random effect
## (this isolates correlation pairwise factoring out other variables)
c <- df %>% correlation(partial=TRUE,multilevel = TRUE)
(s <- c %>% summary(redundant = FALSE ))
## # Correlation Matrix (pearson-method)
##
## Parameter | CHART_BEAUTY | CHART_LIKE | CHART_INTENT | CHART_TRUST | MAKER_TRUST | MAKER_ALIGN | MAKER_SELF | MAKER_ARGUE | MAKER_POLITIC | MAKER_DATA
## ----------------------------------------------------------------------------------------------------------------------------------------------------------
## MAKER_DESIGN | -0.27*** | 0.01 | -0.17*** | 0.05 | -0.03 | 0.07 | 0.07 | 0.08 | 0.08 | 0.32***
## MAKER_DATA | 0.09 | -0.03 | 0.21*** | -0.13*** | -0.15*** | -0.02 | -0.13*** | 9.23e-03 | -0.04 |
## MAKER_POLITIC | 0.01 | -0.02 | 0.03 | 0.04 | -0.06 | -0.19*** | 0.22*** | -0.06 | |
## MAKER_ARGUE | 0.06 | -0.03 | -0.12*** | 0.05 | 0.16*** | 9.31e-03 | -0.16*** | | |
## MAKER_SELF | 5.85e-03 | -0.07 | 0.06 | -0.02 | -0.18*** | -0.34*** | | | |
## MAKER_ALIGN | 0.01 | 0.11** | 0.06 | 0.08 | 0.24*** | | | | |
## MAKER_TRUST | -0.06 | 0.02 | -0.11** | 0.40*** | | | | | |
## CHART_TRUST | 0.03 | 0.23*** | -0.26*** | | | | | | |
## CHART_INTENT | 0.03 | 0.03 | | | | | | | |
## CHART_LIKE | 0.74*** | | | | | | | | |
##
## p-value adjustment method: Holm (1979)
###### VIS WITH CORRELATION PACKAGE
#SEE [correlation] PLOT
g <- plot(s, show_data = "point", show_text = "label",
stars=TRUE, show_legend=FALSE,
show_statistic = FALSE, show_ci = FALSE) +
theme_minimal()+
labs(title = "Correlation Matrix — SD Questions",
subtitle="(partial correlation; pearson method; Holm p-value adjustment; participant as random effect)")
# text = list(fontface = "italic")
g
ggsave(g, scale =1, filename = "figs/level_category/heatmaps/partial_correlation_no_b00.png", width = 14, height = 6, dpi = 320, limitsize = FALSE)
#PLOT GAUSSIAN GRAPH MODEL
# plot(c)
###### VIS WITH CORRPLOT <- -- customizable but can't save to file ARGH
## GET THE MATRIX
m <- as.matrix(c)
## JUST CIRCLES
corrplot(m, method = 'circle', type = 'lower',
order = 'original', diag = FALSE, addCoef.col = "#7A7A7A",
tl.col = "black")
These plots depict the PARTIAL CORRELATION pairwise between variables (partial correlation factors out influence of other variables), with participant ID as a random effect. The resulting values are pearson moment-correlation coefficients ranging of -1 (direct negative) to +1 direct positive correlation. These correlations are calculated on the full scale semantic differential questions (i.e. with the 0 - 100 range, where 1 and 100 are end points and 50 is the central point)
df <- df_graphs_abs %>%
filter(STIMULUS != "B0-0") %>%
select(
MAKER_DESIGN, MAKER_DATA,
MAKER_POLITIC, MAKER_ARGUE,
MAKER_SELF, MAKER_ALIGN, MAKER_TRUST,
CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY,
PID)
print("FULL CORRELATION NO RANDOM EFFECT")
## [1] "FULL CORRELATION NO RANDOM EFFECT"
## CALCULATE full correlations with no random effects
c <- df %>% correlation(partial=FALSE, include_factors=FALSE)
(s <- c %>% summary(redundant = FALSE))
## # Correlation Matrix (pearson-method)
##
## Parameter | CHART_BEAUTY | CHART_LIKE | CHART_INTENT | CHART_TRUST | MAKER_TRUST | MAKER_ALIGN | MAKER_SELF | MAKER_ARGUE | MAKER_POLITIC | MAKER_DATA
## ----------------------------------------------------------------------------------------------------------------------------------------------------------
## MAKER_DESIGN | 0.24*** | 0.23*** | 0.13*** | 0.20*** | 0.19*** | 0.14*** | 0.16*** | 0.18*** | 0.14*** | 0.42***
## MAKER_DATA | 0.18*** | 0.18*** | 0.29*** | 0.25*** | 0.24*** | 0.12*** | 0.19*** | 0.21*** | 0.06* |
## MAKER_POLITIC | 0.17*** | 0.24*** | 0.11*** | 0.31*** | 0.34*** | 0.60*** | 0.50*** | 0.47*** | |
## MAKER_ARGUE | 0.17*** | 0.21*** | 0.23*** | 0.38*** | 0.46*** | 0.46*** | 0.56*** | | |
## MAKER_SELF | 0.21*** | 0.28*** | 0.22*** | 0.41*** | 0.51*** | 0.64*** | | | |
## MAKER_ALIGN | 0.24*** | 0.32*** | 0.21*** | 0.45*** | 0.54*** | | | | |
## MAKER_TRUST | 0.15*** | 0.26*** | 0.30*** | 0.62*** | | | | | |
## CHART_TRUST | 0.32*** | 0.44*** | 0.40*** | | | | | | |
## CHART_INTENT | 0.18*** | 0.21*** | | | | | | | |
## CHART_LIKE | 0.69*** | | | | | | | | |
##
## p-value adjustment method: Holm (1979)
plot(s, show_data="point") + labs(title = "Correlation Matrix",
subtitle="(full correlation; pearson method; Holm p-value adjustment)") + theme_minimal()
print("PARTIAL CORRELATION WITH PID AS RANDOM EFFECT")
## [1] "PARTIAL CORRELATION WITH PID AS RANDOM EFFECT"
#CALCULATE partial correlations with PID as random effect
## (this isolates correlation pairwise factoring out other variables)
c <- df %>% correlation(partial=TRUE, multilevel = TRUE)
(s <- c %>% summary(redundant = FALSE ))
## # Correlation Matrix (pearson-method)
##
## Parameter | CHART_BEAUTY | CHART_LIKE | CHART_INTENT | CHART_TRUST | MAKER_TRUST | MAKER_ALIGN | MAKER_SELF | MAKER_ARGUE | MAKER_POLITIC | MAKER_DATA
## ----------------------------------------------------------------------------------------------------------------------------------------------------------
## MAKER_DESIGN | 0.08 | 0.05 | -0.06 | -2.56e-03 | 0.04 | -0.02 | 0.01 | 0.04 | 0.05 | 0.31***
## MAKER_DATA | 0.03 | -9.61e-03 | 0.17*** | 0.04 | 0.07 | -0.05 | 0.04 | 0.06 | -0.07 |
## MAKER_POLITIC | -5.90e-03 | 0.04 | -0.04 | 0.03 | -0.05 | 0.37*** | 0.10* | 0.24*** | |
## MAKER_ARGUE | 0.02 | -0.02 | 0.04 | 0.04 | 0.14*** | 4.39e-03 | 0.26*** | | |
## MAKER_SELF | -2.83e-04 | 0.03 | 0.02 | -6.34e-03 | 0.12*** | 0.35*** | | | |
## MAKER_ALIGN | 0.03 | 0.06 | 5.07e-03 | 0.05 | 0.22*** | | | | |
## MAKER_TRUST | -0.10* | -0.01 | 0.06 | 0.40*** | | | | | |
## CHART_TRUST | 0.06 | 0.20*** | 0.24*** | | | | | | |
## CHART_INTENT | -1.63e-03 | -8.18e-03 | | | | | | | |
## CHART_LIKE | 0.62*** | | | | | | | | |
##
## p-value adjustment method: Holm (1979)
###### VIS WITH CORRELATION PACKAGE
#SEE [correlation] PLOT
g <- plot(s, show_data = "point", show_text = "label",
stars=TRUE, show_legend=FALSE,
show_statistic = FALSE, show_ci = FALSE) +
theme_minimal()+
labs(title = "Correlation Matrix — SD Questions — absolute values",
subtitle="(partial correlation; pearson method; Holm p-value adjustment; participant as random effect)")
# text = list(fontface = "italic")
g
ggsave(g, scale =1, filename = "figs/level_category/heatmaps/partial_correlation_abs_no_b00.png", width = 14, height = 6, dpi = 320, limitsize = FALSE)
#PLOT GAUSSIAN GRAPH MODEL
# plot(c)
###### VIS WITH CORRPLOT <- -- customizable but can't save to file ARGH
## GET THE MATRIX
m <- as.matrix(c)
## JUST CIRCLES
corrplot(m, method = 'circle', type = 'lower',
order = 'original', diag = FALSE, addCoef.col = "#7A7A7A",
tl.col = "black")
df <- df_graphs %>%
filter(STIMULUS != "B0-0") %>%
select(STIMULUS, STIMULUS_CATEGORY, BLOCK, ENCOUNTER, CHART_LIKE, PID) %>%
mutate(
STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY),
) %>% filter(STIMULUS != "B0-0")
# m <- glm(df)
## CATEGORY
## GGSTATSPLOT
##############################
ggbarstats( data = df, x = ENCOUNTER, y = STIMULUS_CATEGORY,
results.subtitle = FALSE) +
scale_fill_manual(values = my_palettes(name="encounter", direction = "-1")) +
theme_minimal() +
# labs( title = "", x = "", y="") +
theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
##############################
## BLOCK
## GGSTATSPLOT
##############################
ggbarstats( data = df, x = ENCOUNTER, y = BLOCK,
results.subtitle = FALSE) +
scale_fill_manual(values = my_palettes(name="encounter", direction = "-1")) +
theme_minimal() +
# labs( title = "", x = "", y="") +
theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
##############################
## CATEGORY / BLOCK
# GGSTATSPLOT
##############################
grouped_ggbarstats( data = df, x = ENCOUNTER, y = STIMULUS_CATEGORY, grouping.var=BLOCK,
results.subtitle = FALSE,
ggplot.component = scale_fill_manual(values = my_palettes(name="encounter", direction = "-1"))) +
theme_minimal() +
# labs( title = "", x = "", y="") +
theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
##############################
# BLOCK / CATEGORY
# GGSTATSPLOT
##############################
grouped_ggbarstats( data = df, x = ENCOUNTER, y = BLOCK, grouping.var=STIMULUS_CATEGORY,
results.subtitle = FALSE,
ggplot.component = scale_fill_manual(values = my_palettes(name="encounter", direction = "-1"))) +
theme_minimal() +
# labs( title = "", x = "", y="") +
theme(aspect.ratio = 1)
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
##############################
```{{r}}
df <- df_actions %>% select(STIMULUS, STIMULUS_CATEGORY, BLOCK, CHART_ACTION, CHART_LIKE, PID) %>% mutate( CHART_ACTION = fct_rev(CHART_ACTION), STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY), ) %>% filter(STIMULUS != “B0-0”)
3.2.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1
ggbarstats( data = df, x = CHART_ACTION, y = STIMULUS_CATEGORY, results.subtitle = FALSE) + scale_fill_manual(values = my_palettes(name=“actions”, direction = “1”)) + theme_minimal() + # labs( title = ““, x =”“, y=”“) + theme(aspect.ratio = 1) ##############################
3.4.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1
ggbarstats( data = df, x = CHART_ACTION, y = BLOCK, results.subtitle = FALSE) + scale_fill_manual(values = my_palettes(name=“actions”, direction = “1”)) + theme_minimal() + # labs( title = ““, x =”“, y=”“) + theme(aspect.ratio = 1) ##############################
4.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1
grouped_ggbarstats( data = df, x = CHART_ACTION, y = STIMULUS_CATEGORY, grouping.var=BLOCK, results.subtitle = FALSE, ggplot.component = scale_fill_manual(values = my_palettes(name=“actions”, direction = “1”))) + theme_minimal() + # labs( title = ““, x =”“, y=”“) + theme(aspect.ratio = 1) ##############################
6.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1
grouped_ggbarstats( data = df, x = CHART_ACTION, y = BLOCK, grouping.var=STIMULUS_CATEGORY, results.subtitle = FALSE, ggplot.component = scale_fill_manual(values = my_palettes(name=“actions”, direction = “1”))) + theme_minimal() + # labs( title = ““, x =”“, y=”“) + theme(aspect.ratio = 1) ##############################
### WIP DATA AND DESIGN BY CATEGORY and BLOCK
#### visualization
```r
df <- df_graphs %>%
mutate(
## reverse order of MAKER_DATA, because scale ranged from 0=expert to 100=layperson
## we want the reverse
## chose NOT to z-score data, bc we want the data in terms of the original scale
r_MAKER_DATA = reverse_scale(MAKER_DATA),
STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY)
) %>% filter(STIMULUS!="B0-0") %>%
group_by(STIMULUS_CATEGORY, BLOCK) %>%
mutate(
m=mean(MAKER_DATA),
md=median(MAKER_DATA)
)
df %>% ggplot(aes(x=MAKER_DATA, y=BLOCK))+
geom_density_ridges( scale = 0.75) +
# ##MEDIAN
# stat_summary(fun=median, geom="text", colour="red", fontface = "bold", size = 2.5,
# vjust=+2, hjust = 0, aes( label=round(md, digits=0)))+
# stat_summary(fun=median, geom="point", shape=20, size=3, color="red", fill="red") +
## MEAN
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold", size = 2.5,
vjust=+2, hjust = 0, aes( label=round(m, digits=0)))+
stat_summary(fun="mean", geom="point", shape=20, size=3, color="blue", fill="blue") +
facet_wrap(~STIMULUS_CATEGORY)+
labs(title = "MAKER_DATA by BLOCK AND CATEGORY", caption="(mean in blue)")+
theme_minimal() + easy_remove_legend()
## Picking joint bandwidth of 8.98
## Picking joint bandwidth of 9.15
## Picking joint bandwidth of 9.02
## Picking joint bandwidth of 9.8
### LINEAR MIXED EFFECTS MODEL ##################
df <- df_graphs %>%
mutate(
## reverse order of MAKER_DATA, because scale ranged from 0=expert to 100=layperson
## we want the reverse
## chose NOT to z-score data, bc we want the data in terms of the original scale
r_MAKER_DATA = reverse_scale(MAKER_DATA),
STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY)
) %>% filter(STIMULUS!="B0-0")
## SET CONTRASTS
# contrasts(df$MAKER_ID) <-car::contr.Treatment(levels(df$MAKER_ID)) # intercept first group mean; coeff dif from first
## DEFINE MODEL
mr1 <-lmer(r_MAKER_DATA ~ (1|PID) , data=df)
mr2 <-lmer(r_MAKER_DATA ~ (1|PID) + (1|STIMULUS), data=df)
mm1 <-lmer(r_MAKER_DATA ~ STIMULUS + (1|PID) , data=df)
mm2 <-lmer(r_MAKER_DATA ~ STIMULUS_CATEGORY + (1|PID) , data=df)
mm3 <-lmer(r_MAKER_DATA ~ BLOCK + (1|PID) , data=df)
mm4 <-lmer(r_MAKER_DATA ~ STIMULUS_CATEGORY*BLOCK + (1|PID) , data=df)
## sig diff between categories?
print("PREDICTED BY CATEGORY?")
## [1] "PREDICTED BY CATEGORY?"
print("we do expect to see some difference between categories, likely between A and D, however, variance within each category should be substantial")
## [1] "we do expect to see some difference between categories, likely between A and D, however, variance within each category should be substantial"
f <- "MAKER_DATA ~ STIMULUS_CATEGORY"
anova(mm2)
## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## STIMULUS_CATEGORY 57625 19208 3 951 30.447 < 0.00000000000000022 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
r2 = r2(mm2)
means <- estimate_means(mm2, at="STIMULUS_CATEGORY")
contrasts <- estimate_contrasts(mm2, contrast="STIMULUS_CATEGORY",method="pairwise")
plot(contrasts, means) +
geom_text(aes(x=means$STIMULUS_CATEGORY, y=means$Mean, label=round(means$Mean,2)), color="blue", position = position_nudge(x=0.25)) +
theme_minimal() + labs(caption =f, y="predicted MAKER DATA COMPETENCY \n (0=layperson, 100=expert)",
subtitle=paste0("R2 marginal ",round(r2$R2_marginal*100,2),"%"))
print("PREDICTED BY BLOCK")
## [1] "PREDICTED BY BLOCK"
print("we do not expect to see sig diffs btwn blocks if they are aesthetically balanced")
## [1] "we do not expect to see sig diffs btwn blocks if they are aesthetically balanced"
f <- "MAKER_DATA ~ STIMULUS_CATEGORY * BLOCK + (1|PID)"
anova(mm3)
## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## BLOCK 25396 5079.2 5 312 7.3686 0.000001511 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
r2 = r2(mm3)
means <- estimate_means(mm3, at="BLOCK")
contrasts <- estimate_contrasts(mm3, contrast="BLOCK",method="pairwise")
plot(contrasts, means) +
geom_text(aes(x=means$BLOCK, y=means$Mean, label=round(means$Mean,2)), color="blue", position = position_nudge(x=0.25)) +
theme_minimal() + labs(caption =f, y="predicted MAKER DATA COMPETENCY \n (0=layperson, 100=expert)",
subtitle=paste0("R2 marginal ",round(r2$R2_marginal*100,2),"%"))
print("PREDICTED BY INTERACTION")
## [1] "PREDICTED BY INTERACTION"
print("")
## [1] ""
f <- "MAKER_DATA ~ STIMULUS_CATEGORY"
anova(mm4)
## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value
## STIMULUS_CATEGORY 57577 19192.4 3 936 38.7034
## BLOCK 18270 3654.0 5 312 7.3686
## STIMULUS_CATEGORY:BLOCK 135818 9054.6 15 936 18.2594
## Pr(>F)
## STIMULUS_CATEGORY < 0.00000000000000022 ***
## BLOCK 0.000001511 ***
## STIMULUS_CATEGORY:BLOCK < 0.00000000000000022 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
r2 = r2(mm4)
means <- estimate_means(mm4, at=c("STIMULUS_CATEGORY","BLOCK"))
contrasts <- estimate_contrasts(mm4, c("STIMULUS_CATEGORY","BLOCK"),method="pairwise")
plot(contrasts, means) + facet_wrap("BLOCK")+
# geom_text(aes(x=means$BLOCK, y=means$Mean, label=round(means$Mean,2)), color="blue", position = position_nudge(x=0.25)) +
theme_minimal() + labs(caption =f, y="predicted MAKER DATA COMPETENCY \n (0=layperson, 100=expert)",
subtitle=paste0("R2 marginal ",round(r2$R2_marginal*100,2),"%"))
## TEST MODEL FIT
# test_performance(mm2,mm3)
# test_performance(mm2,mm4)
# test_performance(mm3,mm4)
anova(mm2,mm3)
## refitting model(s) with ML (instead of REML)
## Data: df
## Models:
## mm2: r_MAKER_DATA ~ STIMULUS_CATEGORY + (1 | PID)
## mm3: r_MAKER_DATA ~ BLOCK + (1 | PID)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## mm2 6 11942 11973 -5965.1 11930
## mm3 8 11998 12040 -5991.1 11982 0 2 1
print("the model with CATEGORY is not a significantly better fit than the model with BLOCK")
## [1] "the model with CATEGORY is not a significantly better fit than the model with BLOCK"
test_likelihoodratio(mm2, mm4)
## # Likelihood-Ratio-Test (LRT) for Model Comparison (ML-estimator)
##
## Name | Model | df | df_diff | Chi2 | p
## -------------------------------------------------------
## mm2 | lmerModLmerTest | 6 | | |
## mm4 | lmerModLmerTest | 26 | 20 | 280.36 | < .001
print("interaction better fit than category")
## [1] "interaction better fit than category"
test_likelihoodratio(mm3, mm4)
## # Likelihood-Ratio-Test (LRT) for Model Comparison (ML-estimator)
##
## Name | Model | df | df_diff | Chi2 | p
## -------------------------------------------------------
## mm3 | lmerModLmerTest | 8 | | |
## mm4 | lmerModLmerTest | 26 | 18 | 332.40 | < .001
print("interaction better fit than block")
## [1] "interaction better fit than block"
compare_models(mm2,mm3,mm4)
## Parameter | mm2 | mm3 | mm4
## --------------------------------------------------------------------------------------------------------------
## (Intercept) | 70.55 ( 67.62, 73.47) | 56.97 ( 53.13, 60.82) | 64.95 ( 58.56, 71.34)
## STIMULUS CATEGORY (B) | -7.71 (-11.62, -3.81) | | -1.13 ( -9.46, 7.20)
## STIMULUS CATEGORY (C) | -16.10 (-20.01, -12.19) | | -17.56 (-25.89, -9.23)
## STIMULUS CATEGORY (D) | -16.23 (-20.13, -12.32) | | -13.20 (-21.53, -4.87)
## BLOCK (B2) | | 5.47 ( -0.05, 10.99) | 7.75 ( -1.42, 16.91)
## BLOCK (B3) | | 6.62 ( 1.10, 12.14) | 10.59 ( 1.43, 19.76)
## BLOCK (B4) | | 10.79 ( 5.32, 16.26) | 14.11 ( 5.03, 23.19)
## BLOCK (B5) | | -4.67 (-10.16, 0.82) | 4.66 ( -4.46, 13.78)
## BLOCK (B6) | | 3.26 ( -2.26, 8.78) | -3.48 (-12.65, 5.68)
## STIMULUS CATEGORY (B) × BLOCK (B3) | | | -12.80 (-24.75, -0.85)
## STIMULUS CATEGORY (B) × BLOCK (B2) | | | -17.22 (-29.17, -5.27)
## STIMULUS CATEGORY (C) × BLOCK (B2) | | | 15.35 ( 3.40, 27.30)
## STIMULUS CATEGORY (D) × BLOCK (B2) | | | -7.24 (-19.19, 4.71)
## STIMULUS CATEGORY (C) × BLOCK (B4) | | | 15.93 ( 4.10, 27.77)
## STIMULUS CATEGORY (C) × BLOCK (B3) | | | -10.40 (-22.35, 1.55)
## STIMULUS CATEGORY (D) × BLOCK (B3) | | | 7.32 ( -4.64, 19.27)
## STIMULUS CATEGORY (B) × BLOCK (B4) | | | -28.08 (-39.91, -16.24)
## STIMULUS CATEGORY (D) × BLOCK (B5) | | | -16.29 (-28.18, -4.40)
## STIMULUS CATEGORY (D) × BLOCK (B4) | | | -1.13 (-12.97, 10.70)
## STIMULUS CATEGORY (B) × BLOCK (B5) | | | 7.01 ( -4.88, 18.91)
## STIMULUS CATEGORY (C) × BLOCK (B5) | | | -28.04 (-39.93, -16.15)
## STIMULUS CATEGORY (B) × BLOCK (B6) | | | 11.74 ( -0.21, 23.69)
## STIMULUS CATEGORY (C) × BLOCK (B6) | | | 16.03 ( 4.07, 27.98)
## STIMULUS CATEGORY (D) × BLOCK (B6) | | | -0.80 (-12.75, 11.15)
## --------------------------------------------------------------------------------------------------------------
## Observations | 1272 | 1272 | 1272
compare_performance(mr1, mr2, mm1,mm2,mm3,mm4, rank=TRUE)
## # Comparison of Model Performance Indices
##
## Name | Model | R2 (cond.) | R2 (marg.) | ICC | RMSE | Sigma | AIC weights | AICc weights | BIC weights | Performance-Score
## -----------------------------------------------------------------------------------------------------------------------------------------
## mm1 | lmerModLmerTest | 0.348 | 0.232 | 0.150 | 20.885 | 22.268 | 0.500 | 0.500 | 5.59e-15 | 79.12%
## mm4 | lmerModLmerTest | 0.348 | 0.232 | 0.150 | 20.885 | 22.268 | 0.500 | 0.500 | 5.59e-15 | 79.12%
## mr2 | lmerModLmerTest | 0.346 | 0.000 | 0.346 | 20.898 | 22.270 | 2.27e-11 | 3.93e-11 | 1.000 | 62.36%
## mm2 | lmerModLmerTest | 0.160 | 0.060 | 0.106 | 24.046 | 25.117 | 3.20e-53 | 5.45e-53 | 8.19e-45 | 16.89%
## mm3 | lmerModLmerTest | 0.085 | 0.033 | 0.054 | 25.587 | 26.255 | 2.17e-65 | 3.60e-65 | 3.22e-59 | 1.94%
## mr1 | lmerModLmerTest | 0.081 | 0.000 | 0.081 | 25.380 | 26.255 | 6.45e-71 | 1.12e-70 | 3.72e-59 | 1.70%
f <- "MAKER_DATA ~ STIMULUS_CATEGORY * BLOCK + (1|PID)"
## PLOT BEST FIT MODEL PREDICTIONS
(p_data <- cat_plot(mm4, pred = BLOCK, modx = STIMULUS_CATEGORY,
geom = "line", interval.geom= "linerange",
interval=TRUE, int.type = "confidence", int.width = 0.95, robust = TRUE,
plot.points = FALSE) +
facet_wrap(~STIMULUS_CATEGORY) +
labs(title = "LMER Predictions | MAKER_DATA by BLOCK X CATEGORY",
caption = f,
y="MAKER_DATA \n 0(layerpson) --> 100 (professional)") + easy_remove_legend()
)
# if(graph_save){
# ggsave(plot = p_data, path="figs/level_category/models", filename =paste0("lmer_maker_DATA_by_stimulus_category","_ixn.png"), units = c("in"))
# }
## PLOT MODEL PARAMETERS
plot_model(mm4, type = "est",
# show.intercept = TRUE,
show.values = TRUE,
value.offset = .25,
show.p = TRUE
) + theme_minimal() + labs(caption=f)
INTERPRETATION Here we see that a linear mixed effects model, predicting MAKER_DATA by the interaction of STIMULUS_CATEGORY and BLOCK indicates that ratings of maker data competencies do NOT vary consistently as a function of CATEGORY (i.e. the degree of ‘embellishment’). Although the degree of embellishment within a block (A,B,C,D) is the same, the ratings of maker data competency vary. This pattern is particularly salient in categories C and D (with more embellishment). These data suggest that social inferences about a maker’s data competency are not made solely based on the amount of embellishment, but rather, in response to the particular features of the visualization. A highly embellished chart might be rated with relatively high high data competency (e.g. B3-D) or lower data competency (eg. B5-D).
df <- df_graphs %>%
mutate(
## reverse order of MAKER_DATA, because scale ranged from 0=expert to 100=layperson
## we want the reverse
## chose NOT to z-score data, bc we want the data in terms of the original scale
r_MAKER_DESIGN = reverse_scale(MAKER_DESIGN),
STIMULUS_CATEGORY = fct_rev(STIMULUS_CATEGORY)
) %>% filter(STIMULUS!="B0-0")
## DEFINE MODEL
mr1 <-lmer(r_MAKER_DESIGN ~ (1|PID) , data=df)
mr2 <-lmer(r_MAKER_DESIGN ~ (1|PID) + (1|STIMULUS), data=df)
mm1 <-lmer(r_MAKER_DESIGN ~ STIMULUS + (1|PID) , data=df)
mm2 <-lmer(r_MAKER_DESIGN ~ STIMULUS_CATEGORY + (1|PID) , data=df)
mm3 <-lmer(r_MAKER_DESIGN ~ BLOCK + (1|PID) , data=df)
mm4 <-lmer(r_MAKER_DESIGN ~ STIMULUS_CATEGORY*BLOCK + (1|PID) , data=df)
## sig diff between categories?
print("PREDICTED BY CATEGORY?")
## [1] "PREDICTED BY CATEGORY?"
print("we do expect to see some difference between categories, likely between A and D, however, variance within each category should be substantial")
## [1] "we do expect to see some difference between categories, likely between A and D, however, variance within each category should be substantial"
f <- "MAKER_DESIGN ~ STIMULUS_CATEGORY"
anova(mm2)
## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## STIMULUS_CATEGORY 87257 29086 3 951 43.882 < 0.00000000000000022 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
r2 = r2(mm2)
means <- estimate_means(mm2, at="STIMULUS_CATEGORY")
contrasts <- estimate_contrasts(mm2, contrast="STIMULUS_CATEGORY",method="pairwise")
plot(contrasts, means) +
geom_text(aes(x=means$STIMULUS_CATEGORY, y=means$Mean, label=round(means$Mean,2)), color="blue", position = position_nudge(x=0.25)) +
theme_minimal() + labs(caption =f, y="predicted MAKER DESIGN COMPETENCY \n (0=layperson, 100=expert)",
subtitle=paste0("R2 marginal ",round(r2$R2_marginal*100,2),"%"))
print("PREDICTED BY BLOCK")
## [1] "PREDICTED BY BLOCK"
print("we do not expect to see sig diffs btwn blocks if they are aesthetically balanced")
## [1] "we do not expect to see sig diffs btwn blocks if they are aesthetically balanced"
f <- "MAKER_DESIGN ~ BLOCK"
anova(mm3)
## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## BLOCK 21562 4312.5 5 312 5.7332 0.00004446 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
r2 = r2(mm3)
means <- estimate_means(mm3, at="BLOCK")
contrasts <- estimate_contrasts(mm3, contrast="BLOCK",method="pairwise")
plot(contrasts, means) +
geom_text(aes(x=means$BLOCK, y=means$Mean, label=round(means$Mean,2)), color="blue", position = position_nudge(x=0.25)) +
theme_minimal() + labs(caption =f, y="predicted MAKER DESIGN COMPETENCY \n (0=layperson, 100=expert)",
subtitle=paste0("R2 marginal ",round(r2$R2_marginal*100,2),"%"))
print("PREDICTED BY INTERACTION")
## [1] "PREDICTED BY INTERACTION"
print("")
## [1] ""
f <- "MAKER_DESIGN ~ STIMULUS_CATEGORY * BLOCK + (1|PID)"
anova(mm4)
## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value
## STIMULUS_CATEGORY 88006 29335.2 3 936 54.9818
## BLOCK 15294 3058.9 5 312 5.7332
## STIMULUS_CATEGORY:BLOCK 130941 8729.4 15 936 16.3612
## Pr(>F)
## STIMULUS_CATEGORY < 0.00000000000000022 ***
## BLOCK 0.00004446 ***
## STIMULUS_CATEGORY:BLOCK < 0.00000000000000022 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
r2 = r2(mm4)
means <- estimate_means(mm4, at=c("BLOCK","STIMULUS_CATEGORY"))
contrasts <- estimate_contrasts(mm4, c("BLOCK","STIMULUS_CATEGORY"),method="pairwise")
plot(contrasts, means) + facet_wrap("STIMULUS_CATEGORY")+
# geom_text(aes(x=means$BLOCK, y=means$Mean, label=round(means$Mean,2)), color="blue", position = position_nudge(x=0.25)) +
theme_minimal() + labs(caption =f, y="predicted MAKER DESIGN COMPETENCY \n (0=layperson, 100=expert)",
subtitle=paste0("R2 marginal ",round(r2$R2_marginal*100,2),"%"))
## TEST MODEL FIT
# test_performance(mm2,mm3)
# test_performance(mm2,mm4)
# test_performance(mm3,mm4)
anova(mm2,mm3)
## refitting model(s) with ML (instead of REML)
## Data: df
## Models:
## mm2: r_MAKER_DESIGN ~ STIMULUS_CATEGORY + (1 | PID)
## mm3: r_MAKER_DESIGN ~ BLOCK + (1 | PID)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## mm2 6 12002 12032 -5994.8 11990
## mm3 8 12101 12142 -6042.6 12085 0 2 1
print("the model with CATEGORY is not a significantly better fit than the model with BLOCK")
## [1] "the model with CATEGORY is not a significantly better fit than the model with BLOCK"
test_likelihoodratio(mm2, mm4)
## # Likelihood-Ratio-Test (LRT) for Model Comparison (ML-estimator)
##
## Name | Model | df | df_diff | Chi2 | p
## -------------------------------------------------------
## mm2 | lmerModLmerTest | 6 | | |
## mm4 | lmerModLmerTest | 26 | 20 | 250.10 | < .001
print("interaction better fit than category")
## [1] "interaction better fit than category"
test_likelihoodratio(mm3, mm4)
## # Likelihood-Ratio-Test (LRT) for Model Comparison (ML-estimator)
##
## Name | Model | df | df_diff | Chi2 | p
## -------------------------------------------------------
## mm3 | lmerModLmerTest | 8 | | |
## mm4 | lmerModLmerTest | 26 | 18 | 345.87 | < .001
print("interaction better fit than block")
## [1] "interaction better fit than block"
compare_models(mm2,mm3,mm4)
## Parameter | mm2 | mm3 | mm4
## -----------------------------------------------------------------------------------------------------------
## (Intercept) | 47.57 (44.58, 50.56) | 54.07 ( 50.10, 58.04) | 57.91 ( 51.29, 64.52)
## STIMULUS CATEGORY (B) | -0.26 (-4.26, 3.75) | | -6.20 (-14.84, 2.44)
## STIMULUS CATEGORY (C) | 5.50 ( 1.49, 9.51) | | -9.40 (-18.04, -0.76)
## STIMULUS CATEGORY (D) | 20.12 (16.12, 24.13) | | 0.25 ( -8.39, 8.90)
## BLOCK (B2) | | 4.42 ( -1.27, 10.11) | -4.97 (-14.46, 4.52)
## BLOCK (B3) | | -0.43 ( -6.12, 5.26) | -18.37 (-27.86, -8.88)
## BLOCK (B4) | | 3.21 ( -2.43, 8.84) | -8.09 (-17.49, 1.30)
## BLOCK (B5) | | -9.50 (-15.17, -3.84) | -19.46 (-28.90, -10.01)
## BLOCK (B6) | | 1.36 ( -4.34, 7.05) | -11.68 (-21.17, -2.19)
## STIMULUS CATEGORY (B) × BLOCK (B3) | | | 25.85 ( 13.46, 38.25)
## STIMULUS CATEGORY (B) × BLOCK (B2) | | | -15.76 (-28.16, -3.37)
## STIMULUS CATEGORY (C) × BLOCK (B2) | | | 33.84 ( 21.45, 46.24)
## STIMULUS CATEGORY (D) × BLOCK (B2) | | | 19.46 ( 7.06, 31.85)
## STIMULUS CATEGORY (C) × BLOCK (B4) | | | 16.21 ( 3.94, 28.49)
## STIMULUS CATEGORY (C) × BLOCK (B3) | | | 6.25 ( -6.15, 18.64)
## STIMULUS CATEGORY (D) × BLOCK (B3) | | | 39.67 ( 27.27, 52.06)
## STIMULUS CATEGORY (B) × BLOCK (B4) | | | -0.76 (-13.04, 11.51)
## STIMULUS CATEGORY (D) × BLOCK (B5) | | | 19.48 ( 7.15, 31.82)
## STIMULUS CATEGORY (D) × BLOCK (B4) | | | 29.75 ( 17.47, 42.02)
## STIMULUS CATEGORY (B) × BLOCK (B5) | | | 18.43 ( 6.09, 30.76)
## STIMULUS CATEGORY (C) × BLOCK (B5) | | | 1.91 (-10.43, 14.25)
## STIMULUS CATEGORY (B) × BLOCK (B6) | | | 8.26 ( -4.14, 20.65)
## STIMULUS CATEGORY (C) × BLOCK (B6) | | | 32.25 ( 19.85, 44.64)
## STIMULUS CATEGORY (D) × BLOCK (B6) | | | 11.63 ( -0.77, 24.03)
## -----------------------------------------------------------------------------------------------------------
## Observations | 1272 | 1272 | 1272
compare_performance(mr1, mr2, mm1,mm2,mm3,mm4, rank=TRUE)
## # Comparison of Model Performance Indices
##
## Name | Model | R2 (cond.) | R2 (marg.) | ICC | RMSE | Sigma | AIC weights | AICc weights | BIC weights | Performance-Score
## -----------------------------------------------------------------------------------------------------------------------------------------
## mm4 | lmerModLmerTest | 0.347 | 0.235 | 0.147 | 21.684 | 23.099 | 0.500 | 0.500 | 7.26e-15 | 79.16%
## mm1 | lmerModLmerTest | 0.347 | 0.235 | 0.147 | 21.684 | 23.099 | 0.500 | 0.500 | 7.26e-15 | 79.16%
## mr2 | lmerModLmerTest | 0.347 | 0.000 | 0.347 | 21.698 | 23.100 | 1.75e-11 | 3.03e-11 | 1.000 | 62.44%
## mm2 | lmerModLmerTest | 0.179 | 0.085 | 0.103 | 24.672 | 25.745 | 1.20e-46 | 2.03e-46 | 3.97e-38 | 21.94%
## mm3 | lmerModLmerTest | 0.071 | 0.025 | 0.047 | 26.801 | 27.426 | 2.58e-68 | 4.28e-68 | 4.97e-62 | 1.51%
## mr1 | lmerModLmerTest | 0.067 | 0.000 | 0.067 | 26.644 | 27.426 | 3.33e-72 | 5.79e-72 | 2.49e-60 | 1.21%
f <- "MAKER_DATA ~ STIMULUS_CATEGORY * BLOCK + (1|PID)"
## PLOT BEST FIT MODEL PREDICTIONS
(p_design <- cat_plot(mm4, pred = BLOCK, modx = STIMULUS_CATEGORY,
geom = "line", interval.geom= "linerange",
interval=TRUE, int.type = "confidence", int.width = 0.95, robust = TRUE,
plot.points = FALSE) +
facet_wrap(~STIMULUS_CATEGORY) +
labs(title = "LMER Predictions | MAKER_DESIGN by BLOCK X CATEGORY",
caption = f,
y="MAKER_DESIGN \n 0(layerpson) --> 100 (professional)") + easy_remove_legend()
)
# if(graph_save){
# ggsave(plot = p_design, path="figs/level_category/models", filename =paste0("lmer_maker_DESIGN_by_stimulus_category","_ixn.png"), units = c("in"))
# }
## PLOT MODEL PARAMETERS
plot_model(mm4, type = "est",
# show.intercept = TRUE,
show.values = TRUE,
value.offset = .25,
show.p = TRUE
) + theme_minimal() + labs(caption=f)
INTERPRETATION Here we see that a linear mixed effects model, predicting MAKER_DESIGN by the combination of STIMULUS_CATEGORY and BLOCK indicates that ratings of maker design competencies do NOT vary consistently as a function of CATEGORY (i.e. the degree of ‘embellishment’). Although the degree of embellishment within a block (A,B,C,D) is the same, the ratings of maker design competency vary. This pattern is particularly salient in category C. These data suggest that social inferences about a maker’s design competency are not made solely based on the amount of embellishment, but rather, in response to the particular features of the visualization. A highly embellished chart might be rated with relatively high design competency (e.g. B2-C) or lower data competency (eg. B5-C).